home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: Taifun
/
Taifun 102 (1989-08-15)(Ossowski, Stefan)(DE)(PD).zip
/
Taifun 102 (1989-08-15)(Ossowski, Stefan)(DE)(PD).adf
/
Video_V2.11
/
Video_V 2.11
< prev
next >
Wrap
Text File
|
1989-04-26
|
24KB
|
1,193 lines
first:
MENU 1,0,1,""
MENU 2,0,1,""
MENU 3,0,1,""
MENU 4,0,1,""
DEFINT a-z
DIM gr%(7340),ftitel$(400),mwnamen1$(400),mwnamen2$(400),musik$(400),regie$(400)
DIM kasnr%(400)
GOTO start
second:
CLEAR
start:
SCREEN 1,320,200,2,1
WINDOW 2," VIDEO",(0,0)-(310,180),16,1
dateifrage:
CLS
LOCATE 5,1
PRINT "Bitte Dateiname eingeben. "
LOCATE 6,1
PRINT "Wenn kein Name eingegeben wird "
LOCATE 7,1
PRINT "ist der aktuelle Name: "
LOCATE 8,1
PRINT " [VID.FILME_DAT] "
LOCATE 9,1
PRINT "Unter dem eingegeben Namen wird "
LOCATE 10,1
PRINT "die Datei auch abgespeichert. "
LOCATE 13,1
INPUT"",datei$
IF datei$="" THEN
datei$="VID.FILME-DAT"
END IF
CLS
Anfang:
GOSUB grafik
GOSUB farbe
GOSUB abfrage
schluss=1
ablauf:
ON MENU GOSUB mkontrolle:MENU ON
WHILE schluss
SLEEP
WEND
MENU RESET:END
abfrage:
MENU 1,0,1,"Disk"
MENU 1,1,1,"Einlesen"
MENU 1,2,1,"Abspeichern"
MENU 1,3,1,"Drucken"
MENU 1,4,1,"Ende"
MENU 2,0,1,"Verwaltung"
MENU 2,1,1,"Eintragen"
MENU 2,2,1,"Auflisten-Filme"
MENU 2,3,1,"Auflisten-Kassetten"
MENU 2,4,1,"Gesamtlisten"
MENU 2,5,1,"Suchen"
MENU 2,6,1,"Veraendern"
MENU 3,0,1,"Info"
MENU 3,1,1,"Autor"
MENU 3,2,1,"Handhabung"
MENU 4,0,1,""
RETURN
mkontrolle:
IF ausu THEN RETURN
mtitel=MENU (0)
mpunkt=MENU (1)
ON mtitel GOSUB disk,verwaltung,info
RETURN
disk:
ausu=-1
ON mpunkt GOSUB einlesen,abspeichern,drucken,Ende
ausu=0
RETURN
info:
ausu=1
ON mpunkt GOSUB autor,handhabung
ausu=0
RETURN
verwaltung:
ausu=-1
ON mpunkt GOSUB eintragen,auflisten,aufkassette,gesamtliste,suchen,veraendern
ausu=0
RETURN
einlesen:
MENU OFF
CLS
y=0
' ON ERROR GOTO fehler
OPEN datei$ FOR INPUT AS #1
WHILE NOT EOF(1)
y=y+1
LINE INPUT#1,ftitel$(y)
LINE INPUT#1,mwnamen1$(y)
LINE INPUT#1,mwnamen2$(y)
LINE INPUT#1,musik$(y)
LINE INPUT#1,regie$(y)
INPUT#1,kasnr%(y)
WEND
CLOSE#1
vdfilme=y
einlesefilme=y
anlegen=1
MENU ON
GOSUB farbe
RETURN
fehler:
IF ERR=53 THEN
CLOSE#1
LOCATE 7,11
PRINT "Datei ist nicht vorhanden !!!"
LOCATE 9,11
PRINT "Programm wird neu gestartet"
GOSUB taste
RESUME second
END IF
GOTO start
abspeichern:
CLS
MENU OFF
IF speichern=1 THEN
GOTO neudatei
END IF
IF vdfilme=0 OR einlesefilme=vdfilme THEN
COLOR 2,3
LOCATE 8,6
PRINT "Es wurde nichts zum"
LOCATE 10,4
PRINT "abspeichern eingegeben !!"
COLOR 0,1
GOSUB taste
GOTO schlusseintrag
END IF
IF anlegen=1 THEN
GOTO schreibdatei
END IF
GOTO neudatei
schreibdatei:
OPEN datei$ FOR APPEND AS #1
FOR y=einlesefilme+1 TO vdfilme
PRINT #1,ftitel$(y)
PRINT #1,mwnamen1$(y)
PRINT #1,mwnamen2$(y)
PRINT #1,musik$(y)
PRINT #1,regie$(y)
PRINT #1,kasnr%(y)
NEXT
CLOSE #1
anlegen=0
GOTO schlusseintrag
neudatei:
OPEN datei$ FOR OUTPUT AS #1
FOR y=1 TO vdfilme
PRINT #1,ftitel$(y)
PRINT #1,mwnamen1$(y)
PRINT #1,mwnamen2$(y)
PRINT #1,musik$(y)
PRINT #1,regie$(y)
PRINT #1,kasnr%(y)
NEXT
CLOSE #1
speichern=0
schlusseintrag:
IF Ende=1 THEN RETURN
MENU ON
GOSUB farbe
RETURN
Ende:
CLS
MENU OFF
LOCATE 2,13
PRINT "Ende"
Ende=1
IF speichern=1 THEN
LOCATE 4,1
PRINT "Es wurden noch nicht alle"
LOCATE 6,1
PRINT "Eintragungen oder Veränderungen"
LOCATE 8,1
PRINT "neu abgespeichert."
FOR b=0 TO 10000:NEXT
GOSUB abspeichern
LOCATE 10,1
PRINT "Habe soeben alles gespeichert."
LOCATE 12,10
PRINT "Tschüss !!!"
END IF
GOSUB taste:MENU RESET:CLS
WINDOW CLOSE 1
SCREEN CLOSE 1
END
RETURN
eintragen:
COLOR 1,0
CLS
MENU OFF
COLOR 3,2
LOCATE 1,10
PRINT "Eintragen"
x=vdfilme
x=x+1
anfangeintr:
COLOR 1,0
LOCATE 2,1
PRINT "Filme auf schon vorhandenen "
PRINT "Kassetten müssen bei Verändern "
PRINT "eingetragen werden. "
LOCATE 6,11
PRINT "Titel"
LOCATE 7,1
LINE INPUT "",titel$
IF va=1 THEN
IF titel$="0" THEN
va=0
RETURN
END IF
IF titel$="" THEN
LOCATE 9,2
PRINT "Bitte Titel eingeben"
LOCATE 11,2
PRINT "oder [0] für Ende."
GOSUB taste
CLS
GOTO anfangeintr
END IF
vdfilme=vdfilme+1
FOR m=vdfilme TO y+1 STEP -1
ftitel$(m)=ftitel$(m-1)
mwnamen1$(m)=mwnamen1$(m-1)
mwnamen2$(m)=mwnamen2$(m-1)
musik$(m)=musik$(m-1)
regie$(m)=regie$(m-1)
kasnr%(m)=kasnr%(m-1)
NEXT
x=x+1
ftitel$(x)=titel$
speicher=1
END IF
IF titel$="" THEN
x=x-1
GOTO ew
END IF
ftitel$(x)=titel$
LINE INPUT "Mitwirkende: ",mwnamen1$(x)
IF mwnamen1$(x)="" THEN mwnamen1$(x)="Name unbekannt"
LINE INPUT "Mitwirkende: ",mwnamen2$(x)
IF mwnamen2$(x)="" THEN mwnamen2$(x)="Name unbekannt"
LINE INPUT "Musik : ",musik$(x)
IF musik$(x)="" THEN musik$(x)="Name unbekannt"
LINE INPUT "Regie : ",regie$(x)
IF regie$(x)="" THEN regie$(x)="Name unbekannt"
IF va=1 THEN
va=0
RETURN
END IF
kassnr:
LOCATE 12,1
INPUT "Nummer VD-Kassette :",kasnr%(x)
IF kasnr%(x)=0 THEN kassnr
PRINT
ew:
LOCATE 15,10
PRINT "Ende ="
COLOR 3,2
LOCATE 15,18
PRINT ">E<"
COLOR 1,0
LOCATE 16,6
PRINT "Weitermachen ="
COLOR 3,2
LOCATE 16,22
PRINT ">W<"
vdfilme=x
vdwarten:
a$=INKEY$
IF a$="e" THEN
IF einlesefilme=0 THEN
anlegen=1
MENU ON
GOSUB farbe
RETURN
END IF
IF einlesefilme<>vdfilme THEN
speichern=1
END IF
MENU ON
GOSUB farbe
RETURN
END IF
IF a$="w" THEN eintragen
GOTO vdwarten
auflisten:
MENU OFF
CLS
IF vdfilme=0 THEN
fehl$="AUFGELISTET"
GOSUB fehlanzeige
MENU ON
GOSUB farbe
RETURN
END IF
COLOR 3,2
LOCATE 2,10
PRINT "AUFLISTEN"
numfika$="gelistet"
numfika1$="Film-Nr."
GOSUB nummerfika
x=f
CLS
mehrlisten:
COLOR 2,0
IF x>vdfilme THEN weiter
LOCATE z,2
PRINT "Film-Nr."
COLOR 3,2
LOCATE z+1,5
PRINT " "
LOCATE z+1,5
PRINT x
COLOR 2,0
LOCATE z,22
PRINT "Kas.-Nr."
COLOR 3,2
LOCATE z+1,25
PRINT " "
LOCATE z+1,25
PRINT kasnr%(x)
COLOR 2,0
test$=ftitel$(x)
GOSUB stringtest
ftitel$(x)=test$
LOCATE y,1
PRINT " "
LOCATE y,stelle
PRINT ftitel$(x)
IF su= 1 THEN
GOSUB taste
su=0
RETURN
END IF
IF su=2 THEN
IF nrkass=kasnr%(x+1) THEN
x=x+1 :z=z+4 :y=y+4
GOTO mehrlisten
END IF
GOSUB taste
su=0
RETURN
END IF
IF su= 3 THEN
GOSUB taste
su=0
RETURN
END IF
LOCATE 5,10
COLOR 3,2
PRINT "Mitwirkende"
COLOR 1,0
PRINT
test$=mwnamen1$(x)
GOSUB stringtest
mwnamen1$(x)=test$
LOCATE 7,1
PRINT " "
LOCATE 7,stelle
PRINT USING"&";mwnamen1$(x)
test$=mwnamen2$(x)
GOSUB stringtest
mwnamen2$(x)=test$
LOCATE 8,1
PRINT " "
LOCATE 8,stelle
PRINT USING"&";mwnamen2$(x)
COLOR 3,2
LOCATE 10,13
PRINT "Musik";
COLOR 1,0
test$=musik$(x)
GOSUB stringtest
musik$(x)=test$
LOCATE 12,1
PRINT " "
LOCATE 12,stelle
PRINT USING"&";musik$(x)
COLOR 3,2
LOCATE 14,13
PRINT "Regie"
COLOR 1,0
test$=regie$(x)
GOSUB stringtest
regie$(x)=test$
LOCATE 16,1
PRINT " "
LOCATE 16,stelle
PRINT USING"&";regie$(x)
PRINT
COLOR 2,3
LOCATE 18,3
PRINT "WEITER?"
LOCATE 18,22
PRINT "ENDE?"
listfrage:
LINE (40,165)-(65,190),2,bf
LINE (220,165)-(245,190),2,bf
mausfrage:
listen=0
WHILE MOUSE(0)=0
WEND
mx=MOUSE(1):my=MOUSE(2)
IF (mx>40 AND mx<65) AND (my>165 AND my<190) THEN
listen=-1
LINE (40,165)-(65,190),3,bf
SOUND 246,2
x=x+1
END IF
IF (mx>220 AND mx<245) AND (my>165 AND my<190) THEN
listen=1
LINE (220,165)-(245,190),3,bf
SOUND 1318,2
END IF
WHILE MOUSE(0)<>0
WEND
LINE (40,165)-(65,190),2,bf
LINE (220,165)-(245,190),2,bf
IF listen=-1 THEN mehrlisten
IF listen=1 THEN weiter
GOTO mausfrage
weiter:
MENU ON
GOSUB farbe
RETURN
stringtest:
te=LEN(test$)
IF te>31 THEN test$=LEFT$(test$,31)
stelle=INT(16-(LEN(test$)/2))
IF stelle=0 THEN stelle=1
RETURN
suchen:
PALETTE 0,1,1,0 'schwarz
CLS
MENU OFF
COLOR 2
LOCATE 1,12
PRINT "SUCHEN"
IF vdfilme=0 THEN
fehl$="GESUCHT"
GOSUB fehlanzeige
MENU ON
GOSUB farbe
RETURN
END IF
LOCATE 3,3
PRINT "Nach welchem Kriterium soll "
LOCATE 5,3
PRINT "gesucht werden."
LOCATE 9,3
PRINT "(1) Film-Nummer"
LOCATE 11,3
PRINT "(2) Kassetten-Nummer"
LOCATE 13,3
PRINT "(3) Film-Titel"
LOCATE 17,3
PRINT "Bitte auswählen"
austaste:
su$=INKEY$
IF su$="" THEN austaste
IF su$="1" THEN finummer
IF su$="2" THEN kanummer
IF su$="3" THEN fititel
GOTO austaste
finummer:
CLS
LOCATE 1,12
PRINT "SUCHEN"
LOCATE 4,5
PRINT "Bitte jetzt die Nummer "
LOCATE 6,5
PRINT "des Filmes eingeben."
nreingabe:
LOCATE 8,5
PRINT " "
LOCATE 8,5
INPUT "Nr.:",nrfilm
IF nrfilm > vdfilme THEN nreingabe
x=nrfilm :su=1 :z=1 :y=3 :CLS
GOSUB mehrlisten
GOTO schlusuchen
kanummer:
CLS
LOCATE 4,5
PRINT "Bitte jetzt die Nummer"
LOCATE 6,5
PRINT "der Kassette eingeben."
nreingabe1:
LOCATE 8,5
INPUT"Nr.:",nrkass
IF nrkass> kasnr%(vdfilme) THEN nreingabe1
zaehlen:
k=k+1
IF nrkass = kasnr%(k) THEN
x=k :su=2 :z=1 :y=3 :CLS
GOSUB mehrlisten
k=vdfilme
END IF
IF k<= vdfilme THEN zaehlen
k=0
GOTO schlusuchen
fititel:
CLS
LOCATE 3,2
PRINT "Bitte jetzt den gesuchten "
LOCATE 5,2
PRINT "Filmtitel eingeben."
LOCATE 7,2
PRINT "Min. 4 Buchstaben."
suchfilm:
LOCATE 9,2
INPUT suchfilm$
IF LEN(suchfilm$) <4 THEN
PRINT " Min. 4 Buchstaben."
warten=5
GOSUB warte
GOTO fititel
END IF
k=0
wsfilm:
k=k+1
s=LEN(suchfilm$)
sf$=LEFT$(ftitel$(k),s)
s$=UCASE$(sf$):such$=UCASE$(suchfilm$)
IF such$=s$ THEN
x=k :su=3 :z=1 :y=3 :CLS
GOSUB mehrlisten
k=vdfilme
END IF
IF k< vdfilme THEN wsfilm
schlusuchen:
MENU ON
GOSUB farbe
RETURN
veraendern:
CLS
MENU OFF
PALETTE 0,0,0,.6'schwarzblau
PALETTE 1,1,.8,0'sand
PALETTE 2,.6,1,.1'giftgruen
PALETTE 3,.4,.4,.4'dunkelbraun
IF vdfilme=0 THEN
fehl$="VERÄNDERT"
GOSUB fehlanzeige
MENU ON
GOSUB farbe
RETURN
END IF
COLOR 2
LOCATE 2,4
PRINT "Bitte auswählen was ver="
LOCATE 4,4
PRINT "ändert werden soll!!!"
LOCATE 9,5
PRINT "[1] Film löschen"
LOCATE 11,5
PRINT "[2] Film eintragen"
LOCATE 13,5
PRINT "[3] Einträge ändern"
eintaste:
su$=INKEY$
IF su$="" THEN eintaste
IF su$="1" THEN loeschen
IF su$="2" THEN neufilm
IF su$="3" THEN einaendern
GOTO eintaste
loeschen:
CLS
COLOR 2
LOCATE 3,3
PRINT "Welche Film-Nummer soll"
LOCATE 5,3
PRINT "gelöscht werden"
LOCATE 7,3
PRINT "Falls Nummer nicht bekannt,"
LOCATE 9,3
PRINT "0 Eingeben und Auflisten"
LOCATE 11,3
PRINT "auswählen."
eingabeloeschen:
LOCATE 5,19
PRINT " "
LOCATE 5,19
INPUT ;loeschfilm
IF loeschfilm=0 THEN endveraendern
IF loeschfilm>vdfilme THEN eingabeloeschen
CLS
COLOR 1
LOCATE 2,3
PRINT "Soll Film-Nr.";loeschfilm;"wirklich"
LOCATE 4,3
PRINT "gelöscht werden?"
COLOR 3,0
test$=ftitel$(loeschfilm)
GOSUB stringtest
LOCATE 7,stelle
PRINT test$
sicherfrage:
COLOR 1
LOCATE 10,7
PRINT "[J]a oder [N]ein?"
sicher$=INKEY$
IF sicher$="j" THEN wegdamit
IF sicher$="n" THEN endveraendern
GOTO sicherfrage
wegdamit:
speichern=1
IF kasnr%(loeschfilm)>kasnr%(loeschfilm-1) AND kasnr%(loeschfilm)>kasnr%(loeschfilm+1) THEN
GOSUB filmloeschen
GOTO wloeschen
END IF
IF kasnr%(loeschfilm)=kasnr%(loeschfilm-1) THEN
GOSUB filmloeschen
GOTO wloeschen
ELSEIF kasnr%(loeschfilm)=kasnr%(loeschfilm+1) THEN
GOSUB filmloeschen
GOTO wloeschen
END IF
ftitel$(loeschfilm)="noch nichts"
mwnamen1$(loeschfilm)=""
mwnamen2$(loeschfilm)=""
musik$(loeschfilm)=""
regie$(loeschfilm)=""
GOTO endveraendern
wloeschen:
l=loeschfilm
FOR x=l TO vdfilme-1
ftitel$(x)=ftitel$(x+1)
mwnamen1$(x)=mwnamen1$(x+1)
mwnamen2$(x)=mwnamen2$(x+1)
musik$(x)=musik$(x+1)
regie$(x)=regie$(x+1)
kasnr%(x)=kasnr%(x+1)
NEXT
vdfilme=vdfilme-1
GOTO endveraendern
neufilm:
CLS
PALETTE 1,0,0,.6'schwarzblau
PALETTE 0,1,.8,0'sand
COLOR 1
LOCATE 3,2
PRINT "Bitte die Nummer der Kassette"
LOCATE 5,2
PRINT "eingeben,auf der der Film ist."
LOCATE 7,2
PRINT "Die Eingabe von [0] beendet"
LOCATE 9,2
PRINT "den Programmteil."
nummereintragen:
LOCATE 12,2
INPUT "Kassetten-Nr.";einnummer
IF einnummer>kasnr%(vdfilme) THEN
CLS
LOCATE 3,2
PRINT "Diese Kassetten-Nr. existiert"
LOCATE 5,2
PRINT "noch nicht."
GOTO neufilm
END IF
IF einnummer=0 THEN endveraendern
y=1
kassuchen:
IF einnummer=kasnr%(y) THEN
x=y
kasnr%(y)=einnummer
va=1
CLS
GOSUB anfangeintr
GOTO endveraendern
END IF
y=y+1
GOTO kassuchen
einaendern:
CLS
LOCATE 8,2
PRINT "Bei welcher Film-Nr. sollen"
LOCATE 10,2
PRINT "Veränderungen vorgenommen"
LOCATE 12,2
PRINT "werden.";
COLOR 1
PRINT "[ 0 ] ist gleich Ende."
LOCATE 15,2
PRINT "Filmnummer :";
einfinuae:
LOCATE 15,14
INPUT a
IF a=0 THEN
MENU ON
GOSUB farbe
RETURN
END IF
IF a>vdfilme THEN
LOCATE 15,14
PRINT " "
GOTO einfinuae
END IF
COLOR 2
x=0
veraensuch:
CLS
x=x+1
IF x=a THEN
SWAP tausch1$,ftitel$(x)
SWAP tausch2$,mwnamen1$(x)
SWAP tausch3$,mwnamen2$(x)
SWAP tausch4$,musik$(x)
SWAP tausch5$,regie$(x)
LOCATE 6,2
PRINT "Wenn nichts Eingegeben wird,"
LOCATE 8,2
PRINT "wird der alte Name übernommen."
GOSUB taste
CLS
LOCATE 1,1
PRINT "Alter Titel"
PRINT tausch1$
INPUT austausch1$
LOCATE 4,1
PRINT "Mitwirkende 1 Namen Alt"
PRINT tausch2$
INPUT austausch2$
LOCATE 7,1
PRINT "Mitwirkende 2 Name Alt"
PRINT tausch3$
INPUT austausch3$
LOCATE 10,1
PRINT "Musiker-Name Alt"
PRINT tausch4$
INPUT austausch4$
LOCATE 13,1
PRINT "Regie-Namen Alt"
PRINT tausch5$
INPUT austausch5$
LOCATE 17,1
PRINT "Die Kassetten-Nr. wird unver="
PRINT "ändert übernommen."
GOSUB taste
GOTO schlussveraen
END IF
GOTO veraensuch
schlussveraen:
IF austausch1$="" THEN
SWAP ftitel$(x),tausch1$
ELSE
SWAP ftitel$(x),austausch1$
END IF
IF austausch2$="" THEN
SWAP mwnamen1$(x),tausch2$
ELSE
SWAP mwnamen1$(x),austausch2$
speichern=1
END IF
IF austausch3$="" THEN
SWAP mwnamen2$(x),tausch3$
ELSE
SWAP mwnamen2$(x),austausch3$
speichern=1
END IF
IF austausch4$="" THEN
SWAP musik$(x),tausch4$
ELSE
SWAP musik$(x),austausch4$
speichern=1
END IF
IF austausch5$="" THEN
SWAP regie$(x),tausch5$
ELSE
SWAP regie$(x),austausch5$
speichern=1
END IF
endveraendern:
MENU ON
GOSUB farbe
RETURN
warte:
FOR w=0 TO warten*1000
NEXT
warten=0
RETURN
autor:
WINDOW 3,"",(15,10)-(280,80 ),1,1
PRINT " Dies ist ein Public-Domain"
PRINT " Programm."
PRINT " Geschrieben und ausgedacht"
PRINT " von KLAUS-D.WIEGEL "
PRINT " Schröderstr.23 "
PRINT " 4670 LÜNEN "
PRINT " linke Maustaste"
WHILE MOUSE(0)=0
SLEEP
WEND
WHILE MOUSE(0)<>0
WEND
WINDOW CLOSE 3
MENU ON
GOSUB farbe
RETURN
handhabung:
MENU OFF
CLS
LOCATE 1,6
PALETTE 0,1,.8,0
COLOR 1,2
PRINT "H A N D H A B U N G "
COLOR 2,0
LOCATE 3,3
PRINT "Handhabung im DOC-File "
LOCATE 5,3
PRINT "nachsehen."
LOCATE 7,3
PRINT "Viel Spass mit dem Programm"
LOCATE 9,3
PRINT "wünscht der AUTOR."
GOSUB taste
MENU ON
GOSUB farbe
RETURN
taste:
LOCATE 19,7
PRINT "Bitte Taste drücken"
wartetaste:
a$=INKEY$
IF a$<>"" THEN RETURN
SLEEP
GOTO wartetaste
farbe:
COLOR 1,0
PALETTE 0,1,1,1 'weiß
PALETTE 1,1,0,0 'rot
PALETTE 2,0,0,0 'schwarz
PALETTE 3,1,1,0 'gelb
CLS
text:
COLOR 1,0
LOCATE 2,6
PRINT "Video-Film Verwaltung"
PUT (19,19),gr%
COLOR 3,1
LOCATE 8,10
PRINT "Video-Filme"
LOCATE 10,13
PRINT vdfilme
COLOR 1,0
LOCATE 19,5
PRINT "Auswählen mit Menütaste"
RETURN
grafik:
COLOR 1,0
LINE (40,25)-(260,45),2,bf
FOR q=40 TO 256 STEP 6
LINE (q,26)-(q+2,28),0,bf
NEXT
FOR q=40 TO 256 STEP 6
LINE (q,42)-(q+2,44),0,bf
NEXT
FOR q= 40 TO 240 STEP 20
LINE (q,26)-(q,44),0
NEXT
'kassette
LINE (40,110)-(100,140),2,bf
LINE (41,115)-(99,115),0
LINE (44,120)-(68,138),0,bf
LINE (72,120)-(96,138),0,bf
CIRCLE (56,129),10,2
CIRCLE (84,129),10,2
PAINT (56,129),2
PAINT (84,129),2
'kassette
LINE (200,110)-(260,140),2,bf
LINE (201,115)-(258,115),0
LINE (204,120)-(228,138),0,bf
LINE (232,120)-(256,138),0,bf
CIRCLE (216,129),10,2
CIRCLE (244,129),10,2
PAINT (216,129),2
PAINT (244,129),2
'kasten
LINE (85,65)-(220,97),2,bf
LINE (82,62)-(217,94),1,bf
GET (19,19)-(261,141),gr%
RETURN
gesamtliste:
CLS
MENU OFF
IF vdfilme=0 THEN
fehl$="GELISTET"
GOSUB fehlanzeige
MENU ON
GOSUB farbe
RETURN
END IF
numfika$="gelistet"
numfika1$="Film-Nr."
GOSUB nummerfika
CLS
PALETTE 0,.47,.8,.13
PALETTE 1,0,0,.6
PALETTE 2,.2,1,.93
PALETTE 3,.2,.73,1
COLOR 1,0
LOCATE 1,11
PRINT "L I S T E"
LOCATE 2,1
PRINT "Nr. Titel Kas.Nr."
LINE (0,20)-(320,21),2,bf
LINE (0,22)-(320,23),3,bf
LINE (0,24)-(320,25),2,bf
LINE (47,25)-(48,180),3,bf
LINE (265,25)-(266,180),3,bf
zeile=4
linie1=38
FOR x=f TO vdfilme
laenge=LEN(ftitel$(x))
IF laenge>21 THEN
gestitel$=LEFT$(ftitel$(x),21)
GOTO schreibges
END IF
gestitel$=ftitel$(x)
schreibges:
LOCATE zeile,1
PRINT x
LOCATE zeile,6
PRINT gestitel$
LOCATE zeile,28
PRINT kasnr(x)
LINE (0,linie1)-(320,linie1),2
LINE (47,25)-(48,200),3,bf
zeile=zeile+2
linie1=linie1+18
IF zeile=18 THEN
zeile=4
linie1=38
COLOR 3,1
LOCATE 18,7
PRINT "Verlassen mit[E]nde"
COLOR 1,0
GOSUB taste
IF a$=CHR$(101) THEN
x=vdfilme
verlassen=1
GOTO endges
END IF
FOR loesch=4 TO 16 STEP 2
LOCATE loesch,1
PRINT " "
LOCATE loesch,6
PRINT " "
LOCATE loesch,28
PRINT " "
NEXT
END IF
endges:
NEXT
IF verlassen=0 THEN
GOSUB taste
END IF
verlassen=0
MENU ON
GOSUB farbe
RETURN
filmloeschen:
ftitel$(loeschfilm)=""
mwnamen1$(loeschfilm)=""
mwnamen2$(loeschfilm)=""
musik$(loeschfilm)=""
regie$(loeschfilm)=""
kasnr%(loeschfilm)=0
speichern=1
RETURN
aufkassette:
CLS
MENU OFF
IF vdfilme=0 THEN
fehl$="GELISTET"
GOSUB fehlanzeige
MENU ON
GOSUB farbe
RETURN
END IF
numfika$="gelistet"
numfika1$="Kass.-Nr"
GOSUB nummerfika
CLS
suc=1
kasu:
IF kasnr%(suc)<f THEN
suc=suc+1
GOTO kasu
END IF
LOCATE 1,6
COLOR 3,2
PRINT "Auflisten-Kassetten"
zeile=5
aufkas=suc
weiterkas:
COLOR 3,2
LOCATE 1,6
PRINT "Auflisten-Kassetten"
LOCATE 3,8
PRINT "Kassette-Nr.";kasnr%(aufkas)
LOCATE 16,7
PRINT "Verlassen mit [ESC]"
COLOR 1,0
test$=ftitel$(aufkas)
GOSUB stringtest
LOCATE zeile,stelle
PRINT test$
IF kasnr%(aufkas)< kasnr%(aufkas+1) THEN
GOSUB taste
IF a$=CHR$(27) THEN
aufkas=vdfilme
verlassen=1
GOTO endekass
END IF
zeile=3
FOR lo=5 TO 14
LOCATE lo,1
PRINT " "
NEXT
END IF
zeile=zeile+2
aufkas=aufkas+1
IF aufkas<=vdfilme THEN weiterkas
endekass:
IF verlassen=0 THEN
GOSUB taste
END IF
verlassen=0
MENU ON
GOSUB farbe
RETURN
fehlanzeige:
COLOR 1
LOCATE 5,4
PRINT "WAS BITTE SCHÖN SOLL HIER"
LOCATE 6,4
PRINT fehl$;" WERDEN ?? "
LOCATE 7,4
PRINT "ES SIND NOCH KEINE DATEN "
LOCATE 8,4
PRINT "EINGELESEN ODER -GETRAGEN"
LOCATE 9,4
PRINT "WORDEN. "
GOSUB taste
RETURN
drucken:
MENU OFF
CLS
IF vdfilme=0 THEN
fehl$="GEDRUCKT"
GOSUB fehlanzeige
GOSUB farbe
MENU ON
RETURN
END IF
numfika$="gedruckt"
numfika1$="Kass.-Nr."
GOSUB nummerfika
CLS
su=1
drsu:
IF kasnr%(su)<f THEN
su=su+1
GOTO drsu
END IF
WIDTH"lpt1:",80
OPEN"lpt1:"FOR OUTPUT AS #4
COLOR 3,2
aufkas=su
naechstebl:
FOR drk=1 TO 6
LOCATE 1,6
PRINT "Drucken-Kassetten"
druck$(1)=" Kassette-Nr."+STR$(kasnr%(aufkas))+SPACE$(12)
FOR c=2 TO 9 STEP 2
test$=ftitel$(aufkas)
GOSUB drucktest
dt=LEN(STR$(aufkas))
IF dt>1 THEN
leerd=4-dt
END IF
druck$(c)=STR$(aufkas)+SPACE$(leerd)+CHR$(124)+test$+CHR$(124)
druck$(c+1)="-------------------------------------"
IF kasnr%(aufkas)< kasnr%(aufkas+1) THEN
leerstring=1
GOTO cnext
END IF
aufkas=aufkas+1
cnext:
IF leerstring=1 THEN
cd=c+2
FOR d=cd TO 9 STEP 2
druck$(d)=SPACE$(4)+CHR$(124)+SPACE$(32)+CHR$(124)
druck$(d+1)="-------------------------------------"
NEXT
leerstring=0
c=9
END IF
NEXT
aufkas=aufkas+1
IF aufkas>vdfilme THEN ausdru
druck1$(1)=" Kassette-Nr."+STR$(kasnr%(aufkas))+SPACE$(12)
FOR c=2 TO 9 STEP 2
test$=ftitel$(aufkas)
GOSUB drucktest
dt=LEN(STR$(aufkas))
IF dt>1 THEN
leerd=4-dt
END IF
druck1$(c)=STR$(aufkas)+SPACE$(leerd)+CHR$(124)+test$+CHR$(124)
druck1$(c+1)="-------------------------------------"
IF kasnr%(aufkas)< kasnr%(aufkas+1) THEN
leerstring=1
GOTO c2next
aufkas=aufkas-1
END IF
aufkas=aufkas+1
c2next:
IF leerstring=1 THEN
cd=c+2
FOR d=cd TO 9 STEP 2
druck1$(d)=SPACE$(4)+CHR$(124)+SPACE$(32)+CHR$(124)
druck1$(d+1)="-------------------------------------"
NEXT
leerstring=0
c=9
END IF
NEXT
ausdru:
FOR dx=1 TO 9
kadr$=druck$(dx)+druck1$(dx)
PRINT #4,kadr$
NEXT
aufkas=aufkas+1
IF aufkas>vdfilme THEN endedr
NEXT
FOR led=1 TO 12
PRINT #4,
NEXT
GOTO naechstebl
endedr:
MENU ON
CLOSE #4
GOSUB farbe
RETURN
drucktest:
te=LEN(test$)
IF te>32 THEN test$=LEFT$(test$,32)
IF LEN(test$)=32 THEN
RETURN
END IF
leer=INT(LEN(test$)/2)
IF leer<16 THEN
tile=16-leer
test$=SPACE$(tile)+test$+SPACE$(tile)
END IF
IF LEN(test$)<32 THEN
test$=test$+SPACE$(1)
ELSEIF LEN(test$)>32 THEN
test$=LEFT$(test$,32)
END IF'
RETURN
nummerfika:
COLOR 1,0
LOCATE 4,2
PRINT "Bitte die Nummer eingeben"
LOCATE 6,2
PRINT "ab der ";numfika$;" werden soll."
COLOR 3,2
LOCATE 8,17
PRINT "[Anfang=1]"
COLOR 1,0
frageaufl:
LOCATE 12,2
PRINT numfika1$;":";
INPUT "",f
x=f
IF x=0 OR x>vdfilme THEN frageaufl
z=1:y=3
CLS
RETURN